home *** CD-ROM | disk | FTP | other *** search
/ Programmer Plus 2007 / Programmer-Plus-2007.iso / Programming / Microsoft Plateform / Visual Basic 5.0 / Msvb50.ace / msvb50 / MSVB50 / VB / SAMPLES / VISDATA / NEWUG.FRM (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1996-10-16  |  4.4 KB  |  148 lines
  1. VERSION 5.00
  2. Begin VB.Form frmNewUserGroup 
  3.    BorderStyle     =   3  'Fixed Dialog
  4.    ClientHeight    =   1935
  5.    ClientLeft      =   3990
  6.    ClientTop       =   3525
  7.    ClientWidth     =   3480
  8.    BeginProperty Font 
  9.       Name            =   "Tahoma"
  10.       Size            =   8.25
  11.       Charset         =   0
  12.       Weight          =   400
  13.       Underline       =   0   'False
  14.       Italic          =   0   'False
  15.       Strikethrough   =   0   'False
  16.    EndProperty
  17.    Height          =   2400
  18.    HelpContextID   =   2016137
  19.    Icon            =   "NEWUG.frx":0000
  20.    Left            =   3930
  21.    LinkTopic       =   "Form1"
  22.    LockControls    =   -1  'True
  23.    MaxButton       =   0   'False
  24.    MinButton       =   0   'False
  25.    ScaleHeight     =   1935
  26.    ScaleWidth      =   3480
  27.    ShowInTaskbar   =   0   'False
  28.    StartUpPosition =   1  'CenterOwner
  29.    Top             =   3120
  30.    Width           =   3600
  31.    Begin VB.CommandButton cmdCancel 
  32.       Cancel          =   -1  'True
  33.       Caption         =   "&Cancel"
  34.       Default         =   -1  'True
  35.       Height          =   375
  36.       Left            =   1800
  37.       MaskColor       =   &H00000000&
  38.       TabIndex        =   5
  39.       Top             =   1440
  40.       Width           =   1455
  41.    End
  42.    Begin VB.CommandButton cmdOK 
  43.       Caption         =   "&OK"
  44.       Enabled         =   0   'False
  45.       Height          =   375
  46.       Left            =   240
  47.       MaskColor       =   &H00000000&
  48.       TabIndex        =   4
  49.       Top             =   1440
  50.       Width           =   1455
  51.    End
  52.    Begin VB.TextBox txtPID 
  53.       Height          =   285
  54.       Left            =   120
  55.       MaxLength       =   20
  56.       TabIndex        =   3
  57.       Top             =   960
  58.       Width           =   3255
  59.    End
  60.    Begin VB.TextBox txtName 
  61.       Height          =   285
  62.       Left            =   120
  63.       TabIndex        =   1
  64.       Top             =   360
  65.       Width           =   3255
  66.    End
  67.    Begin VB.Label lblLabels 
  68.       AutoSize        =   -1  'True
  69.       Caption         =   "PID:"
  70.       Height          =   195
  71.       Index           =   1
  72.       Left            =   120
  73.       TabIndex        =   2
  74.       Top             =   720
  75.       Width           =   315
  76.    End
  77.    Begin VB.Label lblLabels 
  78.       AutoSize        =   -1  'True
  79.       Caption         =   "Name:"
  80.       Height          =   195
  81.       Index           =   0
  82.       Left            =   120
  83.       TabIndex        =   0
  84.       Top             =   120
  85.       Width           =   465
  86.    End
  87. Attribute VB_Name = "frmNewUserGroup"
  88. Attribute VB_Base = "0{BEE13D53-CA8F-11CF-9ED2-00AA00574745}"
  89. Attribute VB_GlobalNameSpace = False
  90. Attribute VB_Creatable = False
  91. Attribute VB_TemplateDerived = False
  92. Attribute VB_PredeclaredId = True
  93. Attribute VB_Exposed = False
  94. Attribute VB_Customizable = False
  95. Option Explicit
  96. '>>>>>>>>>>>>>>>>>>>>>>>>
  97. Const BUTTON1 = "&OK"
  98. Const BUTTON2 = "&Cancel"
  99. Const Label1 = "&Name:"
  100. Const Label2 = "&PID:"
  101. Const MSG1 = "PID must be between 4 and 20 characters!"
  102. '>>>>>>>>>>>>>>>>>>>>>>>>
  103. Public UserOrGroup As Integer
  104. Private Sub cmdCancel_Click()
  105.   Unload Me
  106. End Sub
  107. Private Sub cmdOK_Click()
  108.   On Error GoTo OKErr
  109.   Dim sTmp As String
  110.   Dim usr As User
  111.   Dim grp As Group
  112.   If Len(txtPID) < 4 Then
  113.     Beep
  114.     MsgBox MSG1, 48
  115.     Exit Sub
  116.   End If
  117.   If UserOrGroup = 0 Then
  118.     Set usr = gwsMainWS.CreateUser(txtName.Text, txtPID.Text)
  119.     gwsMainWS.Users.Append usr
  120.     gwsMainWS.Groups.Refresh
  121.     frmGroupsUsers.lstUsers.AddItem txtName.Text
  122.     frmGroupsUsers.lstGroupsUsers.AddItem txtName.Text
  123.     'add the new user to the Users group by default
  124.     On Error Resume Next  'just in case the users group is gone
  125.     gwsMainWS.Groups("Users").Users.Append usr
  126.     gwsMainWS.Users(txtName.Text).Groups.Refresh
  127.   Else
  128.     Set grp = gwsMainWS.CreateGroup(txtName.Text, txtPID.Text)
  129.     gwsMainWS.Groups.Append grp
  130.     gwsMainWS.Users.Refresh
  131.     frmGroupsUsers.lstGroups.AddItem txtName.Text
  132.     frmGroupsUsers.lstUsersGroups.AddItem txtName.Text
  133.   End If
  134.   Unload Me
  135.   Exit Sub
  136. OKErr:
  137.   ShowError
  138. End Sub
  139. Private Sub Form_Load()
  140.   cmdOK.Caption = BUTTON1
  141.   cmdCancel.Caption = BUTTON2
  142.   lblLabels(0).Caption = Label1
  143.   lblLabels(1).Caption = Label2
  144. End Sub
  145. Private Sub txtName_Change()
  146.   cmdOK.Enabled = Len(txtName.Text) > 0
  147. End Sub
  148.